home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / codeit.zip / ENCODEIT.PAS < prev   
Pascal/Delphi Source File  |  1991-03-29  |  3KB  |  137 lines
  1. Program Encode;
  2. Const
  3.   MaxBuf = 30000;
  4. Var
  5.   Password      : String[6];
  6.   seed1, seed2  : Byte;
  7.   source, dest  : File;
  8.   buffer        : Array [1..MaxBuf] of Byte;
  9.   BytesRead     : Real;
  10.   i             : Integer;
  11.  
  12. (********************************************************************)
  13.  
  14. Procedure OpenFiles;
  15. Const
  16.   s : Array [1..6] Of Char = ('L','O','C','K','E','D');
  17. Begin
  18. Assign(source,ParamStr(1));
  19. (*$I-*)
  20. If IOResult <> 0 Then
  21.   Begin
  22.   Writeln('File not found.');
  23.   Halt;
  24.   End;
  25.  
  26. BlockRead(source,buffer,6);
  27. If ((buffer[1] = ord('L')) And
  28.     (buffer[2] = ord('O')) And
  29.     (buffer[3] = ord('C')) And
  30.     (buffer[4] = ord('K')) And
  31.     (buffer[5] = ord('E')) And
  32.     (buffer[6] = ord('D'))) Then
  33.       Begin
  34.        Writeln('File is already locked.');
  35.        Halt;
  36.        End;
  37.  
  38. Reset(source,1);
  39. Assign(dest,'$$$$$.$$');
  40. Rewrite(dest,1);
  41. BlockWrite(dest,s,6);
  42. BlockWrite(dest,seed1,1);
  43. BlockWrite(dest,seed2,1);
  44. End;
  45.  
  46. (****************************************************************)
  47.  
  48. Procedure GetSeed;
  49. Var
  50.   i, j : Integer;
  51. Begin
  52. Seed1 := 0;
  53. Seed2 := 0;
  54. Password := ParamStr(2);
  55.  
  56. j := Length(Password);
  57. For i:= 1 to Length(Password) Do
  58.   Begin
  59.   Seed1 := Seed1 + (Ord(Password[i]) * i);
  60.   Seed2 := Seed2 + (Ord(Password[i]) * i);
  61.   j := j - 1;
  62.   End;
  63. End;
  64.  
  65. (*****************************************************************)
  66.  
  67. Procedure EncodeFiles;
  68. Var
  69.   i1, i2 : Byte;
  70.   rr     : Integer;
  71. Begin
  72. i1 := Seed1;
  73. i2 := Seed2;
  74. BytesRead := 0;
  75. BlockRead(source, buffer, MaxBuf, rr);
  76. BytesRead := BytesRead + rr;
  77. While rr > 0 Do
  78.   Begin
  79.   For i := 1 to rr Do
  80.     Begin
  81.     i1 := i1 - i;
  82.     i2 := i2 +i;
  83.     If odd(i) Then
  84.       buffer[i] := buffer[i] - i1
  85.     Else
  86.       buffer[i] := buffer[i] + i2;
  87.     End;
  88.   BlockWrite(dest, buffer, rr);
  89.   BlockRead(source, buffer, MaxBuf, rr);
  90.   BytesRead := BytesRead + rr;
  91.   End;
  92. End;
  93.  
  94. (*******************************************************************)
  95.  
  96. Procedure CloseFiles;
  97. Var
  98.   i : Integer;
  99. Begin
  100. Rewrite(source, 1);
  101. FillChar(buffer, MaxBuf, 0);
  102. While BytesRead > 0 Do
  103.   Begin
  104.   If BytesRead > MaxBuf Then
  105.     BlockWrite(source, buffer, MaxBuf)
  106.   Else
  107.     Begin
  108.     i := Trunc(BytesRead);
  109.     BlockWrite(source, buffer, i);
  110.     End;
  111.   BytesRead := BytesRead - MaxBuf;
  112.   End;
  113. Close(source);
  114. Close(dest);
  115. Erase(source);
  116. Rename(dest, ParamStr(1));
  117. End;
  118.  
  119. (***************************************************************)
  120.  
  121. Begin
  122. If Paramcount <> 2 Then
  123.   Begin
  124.   Writeln('Syntax: ENCODEIT Filename password');
  125.   Halt;
  126.   End;
  127. Getseed;
  128. OpenFiles;
  129. EncodeFiles;
  130. CloseFiles;
  131. End.
  132.  
  133.  
  134.  
  135.  
  136.  
  137.